home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / MPW_TOOL / TOOLS / TOOLS_WI / ICON_8 / MEMMON_F / MCONTROL.C < prev    next >
Text File  |  1990-03-02  |  9KB  |  278 lines
  1. /*
  2.  * mcontrol.c: main control of memory monitoring.
  3.  */
  4.  
  5. #include "memmon.h"
  6.  
  7. hidden novalue gcmark Params((word n));
  8.  
  9. static units;
  10. static pausereply = 0;
  11. static initialized = 0;
  12.  
  13. /*
  14.  *  skipgc(n) - skip the first n garbage collections.
  15.  */
  16. novalue skipgc(n)
  17. int n;
  18.    {
  19.    int b, c;
  20.  
  21.    if (gclimit == 0)
  22.       mquit(NormalExit);
  23.    b = 0;
  24.    while (n > 0)  {
  25.       switch (c = getc(ifile)) {
  26.          case EOF:            /* EOF */
  27.             fprintf(stderr, "%s: hit EOF while skipping\n", progname);
  28.             exit(ErrorExit);
  29.             return;
  30.          case '#':            /* comment */
  31.          case ';':            /* pause */
  32.             while ((c = getc(ifile)) != EOF && c != '\n')
  33.                ;
  34.             break;
  35.          case '{':
  36.             ncollect++;
  37.             switch (b - '0') {
  38.                case 4:  /* fall through -- old version of case 0 */
  39.                case 0:  nexplicit++; break;
  40.                case 1:  nstatic++;   break;
  41.                case 2:  nstring++;   break;
  42.                case 3:  nblock++;    break;
  43.             }
  44.             if (ncollect == gclimit)
  45.                mquit(NormalExit);
  46.             break;
  47.          case '}':            /* end marking phase */
  48.             n--;
  49.             break;
  50.          }
  51.       b = c;
  52.       }
  53.    }
  54.  
  55. /*
  56.  *  memmon() - main loop of the memory monitor.
  57.  */
  58. novalue memmon()
  59.    {
  60.    int c;
  61.    word addr, len;
  62.    int colr;
  63.    char buf[LineSize];
  64.  
  65.    if (pauselimit == 0)
  66.       return;
  67.  
  68.    for (;;) switch (c = getcmd(&addr, &len)) {
  69.       case 0:                /* 0: end of file; terminate cleanly */
  70.          if (!initialized) {
  71.             fprintf(stderr, "%s: empty input file\n", progname);
  72.             exit(ErrorExit);
  73.             }
  74.          mpause('d', "done");
  75.          mstatus("done", C_Status);
  76.          return;
  77.       case '#':                /* #: comment */
  78.          while ((c = getc(ifile)) != EOF && c != '\n')
  79.             ;
  80.          break;
  81.       case '<':                /* <: new memory layout */
  82.          units = (len > 0) ? len : 4;    /* set units if specified */
  83.          getregion(&stc);
  84.          getregion(&str);    
  85.          getregion(&blk);    
  86.          refresh();            /* redraw entire screen */
  87.          str.used = 0;            /* will recalculate during marking */
  88.          blk.used = 0;
  89.          paintblk(&stc, (word)0, stc.length, C_Free);
  90.          paintstr((word)0, str.length, C_Free, C_Bsep);
  91.          paintblk(&blk, (word)0, blk.length, C_Free);
  92.          if (ncollect > 0)
  93.             mstatus("compacting", C_Status);
  94.          initialized = 1;
  95.          break;
  96.       case '>':                /* >: new layout is complete */
  97.          mstatus("running", C_Status);
  98.          devflush();
  99.          break;
  100.       case '=':                /* =: check that we're in sync */
  101.          rsync(&stc, "static");
  102.          rsync(&str, "string");
  103.          rsync(&blk, "blk");
  104.          break;
  105.  
  106.       case '"':                /* ": string allocation */
  107.          paintstr(str.used, len, Unmarked + C_String, Unmarked + C_Ssep);
  108.          str.used += len;
  109.          break;
  110.       case '$':                /* $: mmshow() of a string */
  111.          colr = getshow();
  112.          paintstr(addr, len, colr, Unmarked + C_Ssep);
  113.          break;
  114.  
  115.       case 'u':                /* u: Tvsubs   substring trapped var */
  116.       case 'f':                /* f: T_File   file block */
  117.       case 'x':                /* x: T_Refresh  refresh block */
  118.       case 'i':                /* i: T_Bignum long integer */
  119.       case 'r':                /* r: T_Real   real number */
  120.       case 'R':                /* R: T_Record record block */
  121.       case 'S':                /* S: T_Set    set header block */
  122.       case 's':                /* s: T_Selem  set element block */
  123.       case 'L':                /* L: T_List   list header block */
  124.       case 'l':                /* l: T_Lelem  list element block */
  125.       case 'T':                /* T: Table    table header block */
  126.       case 't':                /* t: Telem    table element block */
  127.       case 'h':                /* h: T_Slots  hash buckets (slots) */
  128.       case 'e':                /* e: Tvtbl    table elem trapped var */
  129.       case 'E':                /* E: T_External external block */
  130.       case 'c':                /* c: T_Cset   cset */
  131.  
  132.          len *= units;
  133.          paintblk(&blk, blk.used, len, Unmarked + blkcolor[c]);
  134.          blk.used += len;
  135.          break;
  136.  
  137.       case '%':                /* %: mmshow() in the block region */
  138.          addr *= units;
  139.          len *= units;
  140.          colr = getshow();
  141.          paintblk(&blk, addr, len, colr);
  142.          break;
  143.  
  144.       case 'A':                /* A: alien block in static region */
  145.       case 'F':                /* F: free block in static region */
  146.          addr *= units;
  147.          len *= units;
  148.          paintblk(&stc, addr, len, blkcolor[c]);
  149.          break;
  150.  
  151.       case 'X':                /* X: coexpr block in static region */
  152.          addr *= units;
  153.          len *= units;
  154.          paintblk(&stc, addr, len, Unmarked + blkcolor[c]);
  155.          break;
  156.  
  157.       case 'Y':                /* Y: mmshow() in the static region */
  158.          addr *= units;
  159.          len *= units;
  160.          colr = getshow();
  161.          paintblk(&stc, addr, len, colr);
  162.          break;
  163.  
  164.       case ';':                /* ;: mmpause() call */
  165.          getc(ifile);            /* skip space character */
  166.          fgets(buf, LineSize, ifile);    /* read message */
  167.          buf[strlen(buf)-1] = '\0';    /* remove newline */
  168.          /* pause unless previous reply said "don't stop again" */
  169.          if (pausereply != EOF && pausereply != 'g' && pausereply != 'G')
  170.             pausereply = mpause('p', buf);
  171.          break;
  172.  
  173.       case '{':                /* {: begin marking for garb. coll. */
  174.          gcmark(len);
  175.          break;
  176.       case '!':                /* !: end garbage collection */
  177.          gcwait('c', "end garbage collection");
  178.          if (ncollect == gclimit) {
  179.             mstatus("quit", C_Status);
  180.             mquit(NormalExit);
  181.             }
  182.          mstatus("running", C_Status);
  183.          break;
  184.       default:
  185.          fprintf(stderr, "%s: unexpected input char: %c\n", progname, c);
  186.          exit(ErrorExit);
  187.       }
  188.    }
  189.  
  190. /*
  191.  * gcmark(n) - handle marking phase of garbage collection, reason n.
  192.  */
  193. static novalue gcmark(n)
  194. word n;
  195.    {
  196.    word addr, len;
  197.    int c, markflag;
  198.    char *s;
  199.  
  200.    markflag = showmarking;
  201.    ncollect++;
  202.    switch ((int)n) {
  203.       case 4:  /* fall through -- old version of case 0 */
  204.       case 0:  s = "collect(0) call";    nexplicit++; break;
  205.       case 1:  s = "need static space";  nstatic++;   break;
  206.       case 2:  s = "need string space";  nstring++;   break;
  207.       case 3:  s = "need block space";   nblock++;    break;
  208.       default: s = "g.c. reason lost";                break;
  209.       }
  210.    if (gcwait('f', s) == '+')
  211.       markflag = 0;
  212.    if (markflag)
  213.       mstatus("marking", C_Status);
  214.  
  215.    for (;;) switch (c = getcmd(&addr, &len)) {
  216.       case '#':                /* #: comment */
  217.          while ((c = getc(ifile)) != EOF && c != '\n')
  218.             ;
  219.          break;
  220.       case 0:                /* 0: end of file (shouldn't happen) */
  221.       case '}':                /* }: end marking phase */
  222.          if (markflag)
  223.             do {
  224.                c = gcwait('g', "marking done, garbage remains");
  225.                if (c == EOF || !index(whenpause, 'a'))
  226.                   break;
  227.                setmap(Unmarked, C_Unmarked);
  228.                c = gcwait('a', "active data before compaction");
  229.                setmap(Marked, C_Marked);
  230.                } while (c == '-');
  231.          return;
  232.       case '"':                /* ": string allocation */
  233.          if (markflag)
  234.             paintstr(addr, len, Marked + C_String, Marked + C_Ssep);
  235.          break;
  236.  
  237.       case 'u':                /* u: Tvsubs   substring trapped var */
  238.       case 'f':                /* f: T_File   file block */
  239.       case 'x':                /* x: T_Refresh  refresh block */
  240.       case 'i':                /* i: T_Bignum long integer */
  241.       case 'r':                /* r: T_Real   real number */
  242.       case 'R':                /* R: T_Record record block */
  243.       case 'S':                /* S: T_Set    set header block */
  244.       case 's':                /* s: T_Selem  set element block */
  245.       case 'L':                /* L: T_List   list header block */
  246.       case 'l':                /* l: T_Lelem  list element block */
  247.       case 'T':                /* T: Table    table header block */
  248.       case 't':                /* t: Telem    table element block */
  249.       case 'e':                /* e: Tvtbl    table elem trapped var */
  250.       case 'h':                /* h: T_Slots  hash buckets (slots) */
  251.       case 'E':                /* E: T_External external block */
  252.       case 'c':                /* c: T_Cset   cset */
  253.          if (markflag) {
  254.             addr *= units;
  255.             len *= units;
  256.  
  257.  
  258.             paintblk(&blk, addr, len, Marked + blkcolor[c]);
  259.             }
  260.          break;
  261.  
  262.       case 'A':
  263.       case 'F':
  264.       case 'X':
  265.          if (markflag) {
  266.             addr *= units;
  267.             len *= units;
  268.             paintblk(&stc, addr, len, Marked + blkcolor[c]);
  269.             }
  270.          break;
  271.  
  272.       default:
  273.          fprintf(stderr,"%s: unexpected input char during gc: %c\n",progname,c);
  274.          exit(ErrorExit);
  275.       }
  276.    }
  277.  
  278.